home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / T-COMAL Today / (k)t4.d64 / dumptext1525.l < prev    next >
Text File  |  2007-02-28  |  4KB  |  140 lines
  1. 8000 //DELETE"0:DUMPTEXT1525.L"
  2. 8005 // BY LOREN WRIGHT
  3. 8010 //LIST  "0:DUMPTEXT1525.L"
  4. 8015 //
  5. 8020 //       ░└└└└└└└└└└└└└└└└└«
  6. 8025 //       ▌ 1525 ╨╔╪┼╠ ─╒═╨ ▌
  7. 8030 //    ░└└▒└└└└└└└└└└└└└└└└└▒└└«
  8. 8035 //    ▌ BY ╠OREN ╫RIGHT 7/5/4 ▌
  9. 8040 // ░└└▒└└└└└└└└└└└└└└└└└└└└└└└▒└└«
  10. 8045 // ▌ ╞OR ╥┴═ OR ╥╧═ CHAR SCREENS.▌
  11. 8050 // ▌ AUTOMATICALLY DETERMINES    ▌
  12. 8055 // ▌ SCREEN & CHARSET LOCATION.  ▌
  13. 8060 // ▌ ├ALL WITH: ╨╔╪┼╠'─╒═╨       ▌
  14. 8065 // ½└└└└└└└└└└└└└└└└└└└└└└└└└└└└└│
  15. 8070 // ▌> ╘╚╔╙ ╔╙ ┴ ╘┼╪╘╙├╥┼┼╬ ─╒═╨ <▌
  16. 8075 // ▌╔╘ ╫╧╬'╘ ├╧╨┘ ╘╚┼ ╚╔╥┼╙ ╙├╥╬ ▌
  17. 8080 // ¡└└└└└▓└└└└└└└└└└└└└└└└└▓└└└└└╜
  18. 8085 //       ▌ ╘╥╒┼ 8 ┬╔╘ ─╒═╨ ▌
  19. 8090 //       ¡└└└└└└└└└└└└└└└└└╜
  20. 8095 //
  21. 8100 DIM BYTE#(0:39,0:6), A$ OF 320, B$ OF 8
  22. 8105 PROC PIXEL'DUMP 
  23. 8110 IF PEEK(832)<>162 THEN INSTALL
  24. 8115 OPEN FILE 1,"",UNIT 4,0,WRITE
  25. 8120 INITIALIZE //FIND SCREEN & CHARSET
  26. 8125 STOPFLAG:=FALSE
  27. 8130 PRINT FILE 1: CHR$(8); //GRAPHICS MODE
  28. 8135 FOR GROUP#:=0 TO 21 STEP 7 DO //7 CHAR ROWS TAKE
  29. 8140 FOR PRINT'PASS#:=0 TO 7 DO //8 PRINT-HEAD PASSES
  30. 8145 IF GROUP#=21 AND PRINT'PASS#=4 THEN STOPFLAG:=TRUE //LAST PASS?
  31. 8150 A$:=""
  32. 8155 GET'BYTE //FILL ARRAY WITH DATA FOR ENTIRE PRINT PASS
  33. 8160 FOR COLUMN#:=0 TO 39 DO
  34. 8165 BIT'BANG //CONVERT HORIZONTAL CHAR BYTES TO VERTICAL PRINT-HEAD BYTES
  35. 8170 A$:=A$+B$
  36. 8175 ENDFOR COLUMN#
  37. 8180 PRINT FILE 1: A$
  38. 8185 IF STOPFLAG THEN PRINT'PASS#:=7
  39. 8190 ENDFOR PRINT'PASS#
  40. 8195 ENDFOR GROUP#
  41. 8200 CLOSE FILE 1
  42. 8205 ENDPROC PIXEL'DUMP
  43. 8210 //
  44. 8215 PROC INITIALIZE 
  45. 8220 SET:=LAND(PEEK(53272),14)/2
  46. 8225 BEGIN'SCREEN:=LAND(PEEK(53272),240)/16
  47. 8230 BANK:=3-LAND(PEEK(56576),3)
  48. 8235 W:=(BANK=0 OR BANK=2) AND (SET=2 OR SET=3)
  49. 8240 IF W THEN //TRUE=╥╧═ CHARS
  50. 8245 ADDR:=(SET-2)*2048+53248
  51. 8250 ELSE 
  52. 8255 ADDR:=BANK*16384+SET*2048
  53. 8260 ENDIF 
  54. 8265 ENDPROC INITIALIZE
  55. 8270 //
  56. 8275 PROC GET'BYTE 
  57. 8280 //
  58. 8285 FOR COLUMN#:=0 TO 39 DO
  59. 8290 CX#:=BEGIN'SCREEN*1024+BANK+COLUMN#
  60. 8295 IF PRINT'PASS#>0 THEN
  61. 8300 BYTE#(COLUMN#,0):=PEEK(CX#+40*(GROUP#+PRINT'PASS#-1))
  62. 8305 ENDIF 
  63. 8310 IF PRINT'PASS#<7 THEN
  64. 8315 BYTE#(COLUMN#,1):=PEEK(CX#+40*(GROUP#+PRINT'PASS#))
  65. 8320 ENDIF 
  66. 8325 ENDFOR COLUMN#
  67. 8330 //
  68. 8335 IF W THEN //SWITCH I/O OUT,CHAR ╥╧═ IN
  69. 8340 POKE 56334,LAND(PEEK(56334),254)
  70. 8345 POKE 1,LAND(PEEK(1),251)
  71. 8350 ENDIF 
  72. 8355 //
  73. 8360 FOR COLUMN#:=0 TO 39 DO
  74. 8365 I#:=0
  75. 8370 C1#:=BYTE#(COLUMN#,0)
  76. 8375 C2#:=BYTE#(COLUMN#,1)
  77. 8380 IF PRINT'PASS#>0 THEN
  78. 8385 FOR J#:=8-PRINT'PASS# TO 7 DO
  79. 8390 BYTE#(COLUMN#,I#):=PEEK(ADDR+C1#*8+J#)
  80. 8395 I#:+1
  81. 8400 ENDFOR J#
  82. 8405 ENDIF 
  83. 8410 IF PRINT'PASS#<7 THEN
  84. 8415 FOR J#:=0 TO 6-PRINT'PASS# DO
  85. 8420 BYTE#(COLUMN#,I#):=PEEK(ADDR+C2#*8+J#)
  86. 8425 I#:+1
  87. 8430 ENDFOR J#
  88. 8435 ENDIF 
  89. 8440 ENDFOR COLUMN#
  90. 8445 IF W THEN //SWITCH CHAR ╥╧═ OUT, ╔/╧ IN
  91. 8450 POKE 1,LOR(PEEK(1),4)
  92. 8455 POKE 56334,LOR(PEEK(56334),1)
  93. 8460 ENDIF 
  94. 8465 ENDPROC GET'BYTE
  95. 8470 //
  96. 8475 FUNC LOGICAL'SET'UP(NUM#,MASK#,OP#) CLOSED //FROM ├╧═┴╠ ╘ODAY #1
  97. 8480 POKE 2024,169
  98. 8485 POKE 2025,NUM#
  99. 8490 POKE 2026,OP#
  100. 8495 POKE 2027,MASK#
  101. 8500 POKE 2028,141
  102. 8505 POKE 2029,240
  103. 8510 POKE 2030,7
  104. 8515 POKE 2031,96
  105. 8520 SYS 2024
  106. 8525 RETURN PEEK(2032)
  107. 8530 ENDFUNC LOGICAL'SET'UP
  108. 8535 //
  109. 8540 FUNC LAND(NUM#,MASK#) CLOSED
  110. 8545 RETURN LOGICAL'SET'UP(NUM#,MASK#,41)
  111. 8550 ENDFUNC LAND
  112. 8555 //
  113. 8560 FUNC LOR(NUM#,MASK#) CLOSED
  114. 8565 RETURN LOGICAL'SET'UP(NUM#,MASK#,9)
  115. 8570 ENDFUNC LOR
  116. 8575 //
  117. 8580 PROC INSTALL CLOSED
  118. 8585 FOR I#:=832 TO 881 DO
  119. 8590 READ X#
  120. 8595 POKE I#,X#
  121. 8600 ENDFOR I#
  122. 8605 DATA 162,7,169,0,157,128,3,168,185,120,3,61,106,3,240,9
  123. 8610 DATA 185,106,3,29,128,3,157,128,3,200,192,7,144,234,169,128
  124. 8615 DATA 29,128,3,157,128,3,202,16,217,96,1,2,4,8,16,32
  125. 8620 DATA 64,128
  126. 8625 ENDPROC INSTALL
  127. 8630 //
  128. 8635 PROC BIT'BANG 
  129. 8640 FOR I#:=0 TO 6 DO //7 INPUT BYTES
  130. 8645 POKE 888+I#,BYTE#(COLUMN#,I#)
  131. 8650 ENDFOR I#
  132. 8655 SYS 832
  133. 8660 B$:=""
  134. 8665 FOR I#:=7 TO 0 STEP -1 DO //8 OUTPUT BYTES
  135. 8670 X#:=PEEK(896+I#)
  136. 8675 IF STOPFLAG THEN X#:=LAND(X#,143)
  137. 8680 B$:=B$+CHR$(X#)
  138. 8685 ENDFOR I#
  139. 8690 ENDPROC BIT'BANG
  140.